Attribute VB_Name = "OpenFilePosition"
Private Declare Function SHCreateFromPath Lib "Shell32" Alias "ILCreateFromPathA" (ByVal lpFileName As String) As Long
Private Declare Sub SHFree Lib "Shell32" Alias "ILFree" (ByVal lngPidl As Long)
Private Declare Function SHOpenFolderAndSelectItems Lib "Shell32" ( _
    ByVal pidlFolder As Long, _
    ByVal cidl As Long, _
    ByVal apidl As Long, _
    ByVal dwFlags As Long) As Long

Private Const INVALID_HANDLE_VALUE = -1
Private Const MAX_PATH = 260
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type

Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
    
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" ( _
    ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long
    
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
    
Private Function FileExists(ByVal lpFileName As String) As Boolean
    Dim tpWFD As WIN32_FIND_DATA
    Dim lngFile As Long
    lngFile = FindFirstFile(lpFileName, tpWFD)
    FileExists = lngFile <> INVALID_HANDLE_VALUE
    If lngFile Then Call FindClose(lngFile)
End Function
    
    
Public Function OpenFolderAndSetFileFocus(ByVal lpFileName As String) As Boolean
    On Error Resume Next
    Dim lngPidl As Long
    Dim lngRet As Long
    Dim strFile As String
    strFile = Trim(lpFileName)
    If FileExists(strFile) = False Then Exit Function
    lngPidl = SHCreateFromPath(strFile & vbNullChar)
    If lngPidl <> 0 Then
    lngRet = SHOpenFolderAndSelectItems(lngPidl, 0, 0, 0)
    If lngRet = 0 Then
    penFolderAndSetFileFocus = True
    End If
    Call SHFree(lngPidl)
    End If
End Function

